home *** CD-ROM | disk | FTP | other *** search
/ MacWorld UK 2000 March / MW_UK_2000_03.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / marks.tcl < prev    next >
Encoding:
Text File  |  1999-07-07  |  5.8 KB  |  258 lines  |  [TEXT/ALFA]
  1.  
  2. # ================================================================================
  3. # Marks for front window.
  4. #================================================================================
  5.  
  6. proc namedMarkProc {menu item} {
  7.     switch -- $item {
  8.     "markFile"            {markFile; message "File marked."}
  9.     "set"                 {setNamedMark}
  10.     "goto"                {gotoFileMark}
  11.     "remove"            {removeNamedMark}
  12.     "sort"                {sortMarksFile}
  13.     "sortByPosition"    {orderMarks}
  14.     }
  15. }
  16.  
  17. proc unnamedMarkproc {menu item} {
  18.     switch -- $item {
  19.     "set"                     {setMark}
  20.     "exchangePointAndMark"    {exchangePointAndMark}
  21.     "hilite"                {markHilite}
  22.     }
  23. }
  24.     
  25.  
  26.  
  27. proc gotoFileMark {} {
  28.     set text [getSelect]
  29.     if {[string length $text] && ([string length $text] < 20)} {
  30.     gotoMark [listpick -p "Mark?" -L [list $text] [getNamedMarks -n]]
  31.     } else {
  32.     gotoMark [listpick -p "Mark?" [getNamedMarks -n]]
  33.     }
  34. }
  35.  
  36. proc markFile {} {
  37.     if {[llength [getNamedMarks -n]]} {
  38.     global quietlyClearMarks
  39.     if {$quietlyClearMarks || [dialog::yesno -c "Clear old marks?"]} {
  40.         clearFileMarks
  41.     }
  42.     }
  43.     global mode
  44.     mode::proc MarkFile
  45. }
  46.  
  47. proc ::MarkFile {} {
  48.     message "This mode does not support file marking."
  49. }
  50.  
  51. proc removeAllMarks {{pat *}} {
  52.     set win [win::Current]
  53.     if {![catch {
  54.     foreach mk [getNamedMarks -n] {
  55.         if {[string match $pat $mk]} {
  56.         removeNamedMark -n $mk -w $win
  57.         }
  58.     } } ] } { 
  59.     return 
  60.     }
  61.     # some marks contain curly braces!
  62.     foreach mk [quote::Regfind [getNamedMarks -n]] {
  63.     if {[string match $pat $mk]} {
  64.         removeNamedMark -n $mk -w $win
  65.     }
  66.     if {[string index $mk 0] == "\{"} {
  67.         set mk [string range $mk 1 [expr {[string length $mk] -1}]]
  68.     }
  69.     if {[string match $pat $mk]} {
  70.         removeNamedMark -n $mk -w $win
  71.     }
  72.     }
  73. }
  74.  
  75. proc clearFileMarks {} {removeAllMarks}
  76.  
  77. proc sortMarksFile {} {
  78.     if {![dialog::yesno "Really sort all marks?"]} {return}
  79.     
  80.     set nm [win::Current]
  81.     
  82.     set mks {}
  83.     foreach mk [getNamedMarks] {
  84.     removeNamedMark -n [lindex $mk 0] -w [lindex $mk 1]
  85.     lappend mks $mk
  86.     }
  87.     
  88.     foreach mk [lsort $mks] {
  89.     set name [lindex $mk 0]
  90.     set disp [lindex $mk 2]
  91.     set pos [lindex $mk 3]
  92.     set end [lindex $mk 4]
  93.     
  94.     setNamedMark $name $disp $pos $end
  95.     }
  96. }
  97.  
  98. # From Mark Nagata
  99. proc zeroadd {num} {
  100.     set mx [maxPos]
  101.     set len [string length $mx]
  102.     set num [format "%0${len}d" $num]
  103.     return $num
  104. }
  105.  
  106. proc orderMarks {} {
  107.     if {![dialog::yesno "Really reorder all marks?"]} {return}
  108.     
  109.     set nm [win::Current]
  110.     
  111.     set wks {}
  112.     foreach mk [getNamedMarks] {
  113.     removeNamedMark -n [lindex $mk 0] -w $nm
  114.     set name [lindex $mk 0]
  115.     set disp [lindex $mk 2]
  116.     set pos [lindex $mk 3]
  117.     set end [lindex $mk 4]
  118.     set pos [zeroadd $pos]
  119.     set wk [list $pos $disp $name $end]
  120.     lappend wks $wk
  121.     }
  122.     
  123.     foreach wk [lsort $wks] {
  124.     set name [lindex $wk 2]
  125.     set disp [lindex $wk 1]
  126.     set pos [lindex $wk 0]
  127.     set end [lindex $wk 3]
  128.     
  129.     setNamedMark $name $disp $pos $end
  130.     }
  131. }
  132.  
  133.  
  134. # ================================================================================
  135. # Simple mark stack implementation
  136. # ================================================================================
  137.  
  138. proc placeBookmark {{msg 1}} {
  139.     global markStack
  140.     global markName
  141.     
  142.     set name mark$markName
  143.     incr markName
  144.     createTMark $name [getPos]
  145.     set fileName [win::Current]
  146.     set markStack [linsert $markStack 0 [list $fileName $name]]
  147.     if {$msg} {
  148.     message "Placed bookmark \#[llength $markStack]"
  149.     }
  150. }
  151.  
  152. proc returnToBookmark {{msg 1}} {
  153.     global markStack
  154.     if {[llength $markStack] == "0"} {
  155.     message "No bookmarks have been placed!"
  156.     return
  157.     }
  158.     set mark [lindex [lindex $markStack 0] 1]
  159.     set markStack [lreplace $markStack 0 0]
  160.     if {[catch {gotoTMark $mark}]} {
  161.     returnToBookmark
  162.     return
  163.     }
  164.     if {$msg} {
  165.     message "Returned to bookmark \#[expr {[llength $markStack] + 1}]"
  166.     }
  167. }
  168.  
  169. # Used to create a popup of all funcs in window. Routine 
  170. # should return list containing, consecutively, proc name and
  171. # start of definition. 
  172. proc parseFuncsAlpha {} {
  173.     mode::proc parseFuncs
  174. }
  175.  
  176. proc ::parseFuncs {} {
  177.     global sortFuncsMenu funcExpr parseExpr
  178.     
  179.     set pos [minPos]
  180.     set m {}
  181.     if {$sortFuncsMenu} {
  182.     while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  183.         if {[regexp -- $parseExpr [eval getText $res] dummy word]} {
  184.         lappend m [list $word [lindex $res 0]]
  185.         }
  186.         set pos [lindex $res 1]
  187.     }
  188.     regsub -all "\[\{\}\]" [lsort -ignore $m] "" m
  189.     } else {
  190.     while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  191.         if {[regexp -- $parseExpr [eval getText $res] dummy word]} {
  192.         lappend m $word [lindex $res 0]
  193.         }
  194.         set pos [lindex $res 1]
  195.     }
  196.     }
  197.     return $m
  198. }
  199.  
  200. proc gotoFunc {} {
  201.     set l [parseFuncsAlpha]
  202.     if {[set ind [lsearch $l {(-}]] >= 0} {
  203.     set l [lrange $l [expr {$ind + 2}] end]
  204.     }
  205.     
  206.     while {[llength $l] > 1} {
  207.     lappend names [lindex $l 0]
  208.     lappend positions [lindex $l 1]
  209.     set l [lrange $l 2 end]
  210.     }
  211.     
  212.     set res [listpick -p "Func:" $names]
  213.     if {[set ind [lsearch $names $res]] >= 0} {
  214.     goto [lindex $positions $ind]
  215.     }
  216. }
  217.  
  218.  
  219. proc editMark {fname mname args} {
  220.     if {[set pos [lsearch [winNames -f] "*$fname*"]] >= 0}  {
  221.         bringToFront [lindex [winNames -f] $pos]
  222.     if {[icon -q]} {
  223.         icon -o
  224.     } 
  225.     } else {
  226.         if {[lsearch $args {-r}] >= 0} {
  227.         edit -r "$fname"
  228.         } else {
  229.         edit "$fname"
  230.     }
  231.     }
  232.     set mNames [getNamedMarks -n]
  233.     if {[set closestFound [lsearch -glob $mNames "*${mname}*"]] < 0} {
  234.     catch {mode::proc MarkFile}
  235.     set mNames [getNamedMarks -n]
  236.     } 
  237.     if {[lsearch $mNames "${mname}"] >= 0} {
  238.         gotoMark $mname
  239.     } elseif {[lsearch $mNames " ${mname}"] >= 0} {
  240.     #this gets used when procName is indented in pop-up -tr
  241.         gotoMark " $mname"
  242.     } else {
  243.     if {$closestFound == -1} {
  244.         return 1
  245.     } else {
  246.         gotoMark [lindex $mNames $closestFound]
  247.     }
  248.     
  249.     }
  250.     return 0
  251. }
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.